; compile like this:
; .r ncompl
; elfer.lap(kt)
; and load like this:
; (faz ↓elfer.fas[gra,aam])

(DECLARE (FASLAPSETUP/| T))

(LAP ELFER)        
(DEFSYM ELFCHAN 0)

; ELFINI.  Opens the ELF on a free channel.
; returns T if it worked, Nil if it didn't.  Don't call it more than once.
(ENTRY ELFINI SUBR)
(ARGS ELFINI (NIL . 0))
; code from RPG to find a free channel...
	(move tt point)
	loop1
	(move ar1 0 tt)
	(jumpe ar1 found)
	(aobjn tt loop1)
	(lerr 0 (% sixbit |No channels available!|))
	found
	(hrrzs 0 tt)
	(subi tt chntb)
	(movei ar1 0 tt)
	(movem ar1 chnn)
	(lsh tt 27)
	(movem tt chn)
; at this point tt has the shifted channel number in it, so change all instructions
;  that need it...
	(IORM TT INS1)
	(IORM TT INS2)
	(IORM TT INS3)
	(IORM TT INS4)
	(IORM TT INS5)
	(IORM TT INS6)
	(IORM TT INS7)
	(IORM TT INS8)
	(IORM TT INS9)
	(IORM TT INSA)
	(addi ar1 chntb)
	(movsi tt 400000)
	(movem tt 0 ar1)
	(JRST 0 DOIT)
;	(popj p)

	point           (77776←25 0 chntb)              ;-20,,chntb
	chn             (0)
	chnn            (0)

DOIT
INS1 ; this instruction is modified!
	(OPEN ELFCHAN ELF-OPEN-BLOCK)
	(SKIPA 1 (% 0 0 'NIL))	; lose
	(MOVEI 1 'T)		; success
	(POPJ P)		; return
ELF-OPEN-BLOCK
	(17)			; dump mode
	(455446←22)		; SIXBIT/ELF/
	(0)

; RISKON.  Turns on risky-mode I/O to the elf (faster)
(ENTRY RISKON SUBR)
(ARGS RISKON (NIL . 0))
INS7 ; this instruction is modified!
	(GETSTS ELFCHAN ELF-STATUS)
	(MOVE TT ELF-STATUS)
	(TRO TT 400) ;turn on risky mode in status
	(HRRM TT INS8)
INS8 ; this instruction is modified--twice!
	(060000←22) ; SETSTS ELFCHAN,0
	(MOVEI 1 'T)
	(POPJ P)

ELF-STATUS	(0)

; RISKOFF.  Turns off risky-mode I/O to the elf (faster)
(ENTRY RISKOFF SUBR)
(ARGS RISKOFF (NIL . 0))
INS9 ; this instruction is modified!
	(GETSTS ELFCHAN ELF-STATUS)
	(MOVE TT ELF-STATUS)
	(TRZ TT `400) ;turn on risky mode in status
	(HRRM TT INSA)
INSA ; this instruction is modified--twice!
	(060000←22) ; SETSTS ELFCHAN,0
	(MOVEI 1 'T)
	(POPJ P)

; ELFREL.  Releases the ELF, on channel '10.
(ENTRY ELFREL SUBR)
(ARGS ELFREL (NIL . 0))
INS2 ; this instruction is modified!
	(RELEAS ELFCHAN)
	(POPJ P)

; ELFIN.  Inputs one word from the pdp-11 and returns it.  Call with (ELFIN ADDR)
; note that ELFIN takes a WORD address, but 11TTY works with byte addresses.
(ENTRY ELFIN SUBR)
(ARGS ELFIN (NIL . 1))
	(MOVE 1 0 1)		; get first arg (fixnum)
	(HRRM 1 PEEK-BLOCK)	; save it as addr to peek at
INS3 ; this instruction is modified!
;;; Use an XCT, you loser - rpg
	(MTAPE ELFCHAN PEEK-BLOCK)  ; do the peek
	(SKIPA TT (% 0))	; return 0 if nothing there
	(MOVE TT (+ PEEK-BLOCK 1))
	(JRST 0 FIX1)		; return a fixnum
PEEK-BLOCK
	(2000←22)	; peek function
	(BLOCK 1)		; data word

; ELFOUT.  Opposite of elfin.  Call with (ELFOUT ADDR WORD)
(ENTRY ELFOUT SUBR)
(ARGS ELFOUT (NIL . 2))
	(MOVE 1 0 1)		; get args
	(MOVE 2 0 2)
	(HRRM 1 POKE-BLOCK)	; and do something with them
	(MOVEM 2 (+ POKE-BLOCK 1))
INS4 ; this instruction is modified!
	(MTAPE ELFCHAN POKE-BLOCK)
	(JFCL)
	(POPJ P)
POKE-BLOCK
	(3000←22)	; poke function
	(BLOCK 1)		; data word

; ELFBKO.  Does a block-mode elfout.  Call with (ELFBKO ADDR ARRAY)
(ENTRY ELFBKO SUBR)
(ARGS ELFBKO (NIL . 2))
	(MOVE 1 0 1)		; get addr
	(TRO 1 400000)		; set "unibus address" bit
	(TLO 1 400000)		; also set mode to 1 11 word per 10 word, right just
INS5 ; this instruction is modified!
	(USETO ELFCHAN 1)	; set unibus output addr
	(MOVE 2 1 2)		; get addr of array
	(SUBI 2 1)		; set up iowd
	(MOVEM 2 IO-WORD)
	(MOVN 2 -1 2)		; get -length of array
	(HRLM 2 IO-WORD)	; finish iowd
INS6 ; this instruction is modified!
	(OUTPUT ELFCHAN IO-WORD) ; splat
	(POPJ P)
IO-WORD	(BLOCK 1)

; CLICK. Clicks the horton box...argument determines which color, 4=red 2=green 1=blue
(ENTRY CLICK SUBR)
(ARGS CLICK (NIL . 1))
	(CALLI 0 400005) ; eiotm
	(MOVE 1 0 1)
	(LSH 1 13.)
	(MOVE 2 1)
	(IOR 2 CON1)
	(XCT 0 2)	; click on
	(MOVEI 3 1)	; wait one sec
	(CALLI 3 31)
	(MOVE 2 1)
	(IOR 2 CON2)
	(XCT 0 2)
	(CALLI 0 400006) ; liotm
	(POPJ P)
CON1	(735600←22)	   ; CONO CAR,0
CON2	(735600←22 0 400000) ; CONO CAR,400000

NIL